home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / calc202a.lha / calc-2.02a / calc-aent.el next >
Lisp/Scheme  |  1993-06-01  |  36KB  |  1,163 lines
  1. ;; Calculator for GNU Emacs, part I [calc-aent.el]
  2. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
  3. ;; Written by Dave Gillespie, daveg@synaptics.com.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23.  
  24. ;; This file is autoloaded from calc.el.
  25. (require 'calc)
  26.  
  27. (require 'calc-macs)
  28.  
  29. (defun calc-Need-calc-aent () nil)
  30.  
  31.  
  32. (defun calc-do-quick-calc ()
  33.   (calc-check-defines)
  34.   (if (eq major-mode 'calc-mode)
  35.       (calc-algebraic-entry t)
  36.     (let (buf shortbuf)
  37.       (save-excursion
  38.     (calc-create-buffer)
  39.     (let* ((calc-command-flags nil)
  40.            (calc-dollar-values calc-quick-prev-results)
  41.            (calc-dollar-used 0)
  42.            (enable-recursive-minibuffers t)
  43.            (calc-language (if (memq calc-language '(nil big))
  44.                   'flat calc-language))
  45.            (entry (calc-do-alg-entry "" "Quick calc: " t))
  46.            (alg-exp (mapcar (function
  47.                  (lambda (x)
  48.                    (if (and (not calc-extensions-loaded)
  49.                         calc-previous-alg-entry
  50.                         (string-match
  51.                          "\\`[-0-9._+*/^() ]+\\'"
  52.                          calc-previous-alg-entry))
  53.                        (calc-normalize x)
  54.                      (calc-extensions)
  55.                      (math-evaluate-expr x))))
  56.                 entry)))
  57.       (if (and (= (length alg-exp) 1)
  58.            (eq (car-safe (car alg-exp)) 'calcFunc-assign)
  59.            (= (length (car alg-exp)) 3)
  60.            (eq (car-safe (nth 1 (car alg-exp))) 'var))
  61.           (progn
  62.         (calc-extensions)
  63.         (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
  64.         (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
  65.         (setq alg-exp (list (nth 2 (car alg-exp))))))
  66.       (setq calc-quick-prev-results alg-exp
  67.         buf (mapconcat (function (lambda (x)
  68.                        (math-format-value x 1000)))
  69.                    alg-exp
  70.                    " ")
  71.         shortbuf buf)
  72.       (if (and (= (length alg-exp) 1)
  73.            (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
  74.            (< (length buf) 20)
  75.            (= calc-number-radix 10))
  76.           (setq buf (concat buf "  ("
  77.                 (let ((calc-number-radix 16))
  78.                   (math-format-value (car alg-exp) 1000))
  79.                 ", "
  80.                 (let ((calc-number-radix 8))
  81.                   (math-format-value (car alg-exp) 1000))
  82.                 (if (and (integerp (car alg-exp))
  83.                      (> (car alg-exp) 0)
  84.                      (< (car alg-exp) 127))
  85.                     (format ", \"%c\"" (car alg-exp))
  86.                   "")
  87.                 ")")))
  88.       (if (and (< (length buf) (screen-width)) (= (length entry) 1)
  89.            calc-extensions-loaded)
  90.           (let ((long (concat (math-format-value (car entry) 1000)
  91.                   " =>  " buf)))
  92.         (if (<= (length long) (- (screen-width) 8))
  93.             (setq buf long))))
  94.       (calc-handle-whys)
  95.       (message "Result: %s" buf)))
  96.       (if (eq last-command-char 10)
  97.       (insert shortbuf)
  98.     (setq kill-ring (cons shortbuf kill-ring))
  99.     (if (> (length kill-ring) kill-ring-max)
  100.         (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
  101.     (setq kill-ring-yank-pointer kill-ring))))
  102. )
  103.  
  104. (defun calc-do-calc-eval (str separator args)
  105.   (calc-check-defines)
  106.   (catch 'calc-error
  107.     (save-excursion
  108.       (calc-create-buffer)
  109.       (cond
  110.        ((and (consp str) (not (symbolp (car str))))
  111.     (let ((calc-language nil)
  112.           (math-expr-opers math-standard-opers)
  113.           (calc-internal-prec 12)
  114.           (calc-word-size 32)
  115.           (calc-symbolic-mode nil)
  116.           (calc-matrix-mode nil)
  117.           (calc-angle-mode 'deg)
  118.           (calc-number-radix 10)
  119.           (calc-leading-zeros nil)
  120.           (calc-group-digits nil)
  121.           (calc-point-char ".")
  122.           (calc-frac-format '(":" nil))
  123.           (calc-prefer-frac nil)
  124.           (calc-hms-format "%s@ %s' %s\"")
  125.           (calc-date-format '((H ":" mm C SS pp " ")
  126.                   Www " " Mmm " " D ", " YYYY))
  127.           (calc-float-format '(float 0))
  128.           (calc-full-float-format '(float 0))
  129.           (calc-complex-format nil)
  130.           (calc-matrix-just nil)
  131.           (calc-full-vectors t)
  132.           (calc-break-vectors nil)
  133.           (calc-vector-commas ",")
  134.           (calc-vector-brackets "[]")
  135.           (calc-matrix-brackets '(R O))
  136.           (calc-complex-mode 'cplx)
  137.           (calc-infinite-mode nil)
  138.           (calc-display-strings nil)
  139.           (calc-simplify-mode nil)
  140.           (calc-display-working-message 'lots)
  141.           (strp (cdr str)))
  142.       (while strp
  143.         (set (car strp) (nth 1 strp))
  144.         (setq strp (cdr (cdr strp))))
  145.       (calc-do-calc-eval (car str) separator args)))
  146.        ((eq separator 'eval)
  147.     (eval str))
  148.        ((eq separator 'macro)
  149.     (calc-extensions)
  150.     (let* ((calc-buffer (current-buffer))
  151.            (calc-window (get-buffer-window calc-buffer))
  152.            (save-window (selected-window)))
  153.       (if calc-window
  154.           (unwind-protect
  155.           (progn
  156.             (select-window calc-window)
  157.             (calc-execute-kbd-macro str nil (car args)))
  158.         (and (window-point save-window)
  159.              (select-window save-window)))
  160.         (save-window-excursion
  161.           (select-window (get-largest-window))
  162.           (switch-to-buffer calc-buffer)
  163.           (calc-execute-kbd-macro str nil (car args)))))
  164.     nil)
  165.        ((eq separator 'pop)
  166.     (or (not (integerp str))
  167.         (= str 0)
  168.         (calc-pop (min str (calc-stack-size))))
  169.     (calc-stack-size))
  170.        ((eq separator 'top)
  171.     (and (integerp str)
  172.          (> str 0)
  173.          (<= str (calc-stack-size))
  174.          (math-format-value (calc-top-n str (car args)) 1000)))
  175.        ((eq separator 'rawtop)
  176.     (and (integerp str)
  177.          (> str 0)
  178.          (<= str (calc-stack-size))
  179.          (calc-top-n str (car args))))
  180.        (t
  181.     (let* ((calc-command-flags nil)
  182.            (calc-next-why nil)
  183.            (calc-language (if (memq calc-language '(nil big))
  184.                   'flat calc-language))
  185.            (calc-dollar-values (mapcar
  186.                     (function
  187.                      (lambda (x)
  188.                        (if (stringp x)
  189.                        (progn
  190.                          (setq x (math-read-exprs x))
  191.                          (if (eq (car-safe x)
  192.                              'error)
  193.                          (throw 'calc-error
  194.                             (calc-eval-error
  195.                              (cdr x)))
  196.                            (car x)))
  197.                      x)))
  198.                     args))
  199.            (calc-dollar-used 0)
  200.            (res (if (stringp str)
  201.             (math-read-exprs str)
  202.               (list str)))
  203.            buf)
  204.       (if (eq (car res) 'error)
  205.           (calc-eval-error (cdr res))
  206.         (setq res (mapcar 'calc-normalize res))
  207.         (and (memq 'clear-message calc-command-flags)
  208.          (message ""))
  209.         (cond ((eq separator 'pred)
  210.            (calc-extensions)
  211.            (if (= (length res) 1)
  212.                (math-is-true (car res))
  213.              (calc-eval-error '(0 "Single value expected"))))
  214.           ((eq separator 'raw)
  215.            (if (= (length res) 1)
  216.                (car res)
  217.              (calc-eval-error '(0 "Single value expected"))))
  218.           ((eq separator 'list)
  219.            res)
  220.           ((memq separator '(num rawnum))
  221.            (if (= (length res) 1)
  222.                (if (math-constp (car res))
  223.                (if (eq separator 'num)
  224.                    (math-format-value (car res) 1000)
  225.                  (car res))
  226.              (calc-eval-error
  227.               (list 0
  228.                 (if calc-next-why
  229.                     (calc-explain-why (car calc-next-why))
  230.                   "Number expected"))))
  231.              (calc-eval-error '(0 "Single value expected"))))
  232.           ((eq separator 'push)
  233.            (calc-push-list res)
  234.            nil)
  235.           (t (while res
  236.                (setq buf (concat buf
  237.                      (and buf (or separator ", "))
  238.                      (math-format-value (car res) 1000))
  239.                  res (cdr res)))
  240.              buf))))))))
  241. )
  242.  
  243. (defun calc-eval-error (msg)
  244.   (if (and (boundp 'calc-eval-error)
  245.        calc-eval-error)
  246.       (if (eq calc-eval-error 'string)
  247.       (nth 1 msg)
  248.     (error "%s" (nth 1 msg)))
  249.     msg)
  250. )
  251.  
  252.  
  253. ;;;; Reading an expression in algebraic form.
  254.  
  255. (defun calc-auto-algebraic-entry (&optional prefix)
  256.   (interactive "P")
  257.   (calc-algebraic-entry prefix t)
  258. )
  259.  
  260. (defun calc-algebraic-entry (&optional prefix auto)
  261.   (interactive "P")
  262.   (calc-wrapper
  263.    (let ((calc-language (if prefix nil calc-language))
  264.      (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
  265.      (calc-alg-entry (and auto (char-to-string last-command-char)))))
  266. )
  267.  
  268. (defun calc-alg-entry (&optional initial prompt)
  269.   (let* ((sel-mode nil)
  270.      (calc-dollar-values (mapcar 'calc-get-stack-element
  271.                      (nthcdr calc-stack-top calc-stack)))
  272.      (calc-dollar-used 0)
  273.      (calc-plain-entry t)
  274.      (alg-exp (calc-do-alg-entry initial prompt t)))
  275.     (if (stringp alg-exp)
  276.     (progn
  277.       (calc-extensions)
  278.       (calc-alg-edit alg-exp))
  279.       (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j)
  280.                      'none
  281.                    calc-simplify-mode))
  282.          (nvals (mapcar 'calc-normalize alg-exp)))
  283.     (while alg-exp
  284.       (calc-record (if calc-extensions-loaded (car alg-exp) (car nvals))
  285.                "alg'")
  286.       (calc-pop-push-record-list calc-dollar-used
  287.                      (and (not (equal (car alg-exp)
  288.                               (car nvals)))
  289.                       calc-extensions-loaded
  290.                       "")
  291.                      (list (car nvals)))
  292.       (setq alg-exp (cdr alg-exp)
  293.         nvals (cdr nvals)
  294.         calc-dollar-used 0)))
  295.       (calc-handle-whys)))
  296. )
  297.  
  298. (defun calc-do-alg-entry (&optional initial prompt no-normalize)
  299.   (let* ((calc-buffer (current-buffer))
  300.      (blink-paren-hook 'calcAlg-blink-matching-open)
  301.      (alg-exp 'error))
  302.     (if (boundp 'calc-alg-ent-map)
  303.     ()
  304.       (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
  305.       (define-key calc-alg-ent-map "'" 'calcAlg-previous)
  306.       (define-key calc-alg-ent-map "`" 'calcAlg-edit)
  307.       (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
  308.       (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
  309.       (setq calc-alg-ent-esc-map (copy-sequence esc-map))
  310.       (or (string-match "^19" emacs-version)
  311.       (let ((i 33))
  312.         (while (< i 127)
  313.           (aset calc-alg-ent-esc-map i 'calcAlg-escape)
  314.           (setq i (1+ i))))))
  315.     (define-key calc-alg-ent-map "\e" nil)
  316.     (if (eq calc-algebraic-mode 'total)
  317.     (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
  318.       (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
  319.       (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
  320.       (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
  321.       (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
  322.       (define-key calc-alg-ent-map "\e%" 'self-insert-command))
  323.     (setq calc-aborted-prefix nil)
  324.     (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
  325.                      (or initial "")
  326.                      calc-alg-ent-map nil)))
  327.       (if (eq alg-exp 'error)
  328.       (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
  329.           (setq alg-exp nil)))
  330.       (setq calc-aborted-prefix "alg'")
  331.       (or no-normalize
  332.       (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
  333.       alg-exp))
  334. )
  335.  
  336. (defun calcAlg-plus-minus ()
  337.   (interactive)
  338.   (if (calc-minibuffer-contains ".* \\'")
  339.       (insert "+/- ")
  340.     (insert " +/- "))
  341. )
  342.  
  343. (defun calcAlg-mod ()
  344.   (interactive)
  345.   (if (not (calc-minibuffer-contains ".* \\'"))
  346.       (insert " "))
  347.   (if (calc-minibuffer-contains ".* mod +\\'")
  348.       (if calc-previous-modulo
  349.       (insert (math-format-flat-expr calc-previous-modulo 0))
  350.     (beep))
  351.     (insert "mod "))
  352. )
  353.  
  354. (defun calcAlg-previous ()
  355.   (interactive)
  356.   (if (calc-minibuffer-contains "\\`\\'")
  357.       (if calc-previous-alg-entry
  358.       (insert calc-previous-alg-entry)
  359.     (beep))
  360.     (insert "'"))
  361. )
  362.  
  363. (defun calcAlg-equals ()
  364.   (interactive)
  365.   (unwind-protect
  366.       (calcAlg-enter)
  367.     (if (consp alg-exp)
  368.     (setq prefix-arg (length alg-exp)
  369.           unread-command-char ?=)))
  370. )
  371.  
  372. (defun calcAlg-escape ()
  373.   (interactive)
  374.   (setq unread-command-char last-command-char)
  375.   (save-excursion
  376.     (calc-select-buffer)
  377.     (use-local-map calc-mode-map))
  378.   (calcAlg-enter)
  379. )
  380.  
  381. (defun calcAlg-edit ()
  382.   (interactive)
  383.   (if (or (not calc-plain-entry)
  384.       (calc-minibuffer-contains
  385.        "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
  386.       (insert "`")
  387.     (setq alg-exp (buffer-string))
  388.     (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
  389.     (exit-minibuffer))
  390. )
  391. (setq calc-plain-entry nil)
  392.  
  393. (defun calcAlg-enter ()
  394.   (interactive)
  395.   (let* ((str (buffer-string))
  396.      (exp (and (> (length str) 0)
  397.            (save-excursion
  398.              (set-buffer calc-buffer)
  399.              (math-read-exprs str)))))
  400.     (if (eq (car-safe exp) 'error)
  401.     (progn
  402.       (goto-char (point-min))
  403.       (forward-char (nth 1 exp))
  404.       (beep)
  405.       (calc-temp-minibuffer-message
  406.        (concat " [" (or (nth 2 exp) "Error") "]"))
  407.       (setq unread-command-char -1))
  408.       (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
  409.             '((incomplete vec))
  410.               exp))
  411.       (and (> (length str) 0) (setq calc-previous-alg-entry str))
  412.       (exit-minibuffer)))
  413. )
  414.  
  415. (defun calcAlg-blink-matching-open ()
  416.   (let ((oldpos (point))
  417.     (blinkpos nil))
  418.     (save-excursion
  419.       (condition-case ()
  420.       (setq blinkpos (scan-sexps oldpos -1))
  421.     (error nil)))
  422.     (if (and blinkpos
  423.          (> oldpos (1+ (point-min)))
  424.          (or (and (= (char-after (1- oldpos)) ?\))
  425.               (= (char-after blinkpos) ?\[))
  426.          (and (= (char-after (1- oldpos)) ?\])
  427.               (= (char-after blinkpos) ?\()))
  428.          (save-excursion
  429.            (goto-char blinkpos)
  430.            (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
  431.     (let ((saved (aref (syntax-table) (char-after blinkpos))))
  432.       (unwind-protect
  433.           (progn
  434.         (aset (syntax-table) (char-after blinkpos)
  435.               (+ (logand saved 255)
  436.              (lsh (char-after (1- oldpos)) 8)))
  437.         (blink-matching-open))
  438.         (aset (syntax-table) (char-after blinkpos) saved)))
  439.       (blink-matching-open)))
  440. )
  441.  
  442.  
  443. (defun calc-alg-digit-entry ()
  444.   (calc-alg-entry 
  445.    (cond ((eq last-command-char ?e)
  446.       (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
  447.      ((eq last-command-char ?#) (format "%d#" calc-number-radix))
  448.      ((eq last-command-char ?_) "-")
  449.      ((eq last-command-char ?@) "0@ ")
  450.      (t (char-to-string last-command-char))))
  451. )
  452.  
  453. (defun calcDigit-algebraic ()
  454.   (interactive)
  455.   (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
  456.       (calcDigit-key)
  457.     (setq calc-digit-value (buffer-string))
  458.     (exit-minibuffer))
  459. )
  460.  
  461. (defun calcDigit-edit ()
  462.   (interactive)
  463.   (setq unread-command-char last-command-char)
  464.   (setq calc-digit-value (buffer-string))
  465.   (exit-minibuffer)
  466. )
  467.  
  468.  
  469. ;;; Algebraic expression parsing.   [Public]
  470.  
  471. (defun math-read-exprs (exp-str)
  472.   (let ((exp-pos 0)
  473.     (exp-old-pos 0)
  474.     (exp-keep-spaces nil)
  475.     exp-token exp-data)
  476.     (if calc-language-input-filter
  477.     (setq exp-str (funcall calc-language-input-filter exp-str)))
  478.     (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
  479.       (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
  480.                 (substring exp-str (+ exp-token 2)))))
  481.     (math-build-parse-table)
  482.     (math-read-token)
  483.     (let ((val (catch 'syntax (math-read-expr-list))))
  484.       (if (stringp val)
  485.       (list 'error exp-old-pos val)
  486.     (if (equal exp-token 'end)
  487.         val
  488.       (list 'error exp-old-pos "Syntax error")))))
  489. )
  490.  
  491. (defun math-read-expr-list ()
  492.   (let* ((exp-keep-spaces nil)
  493.      (val (list (math-read-expr-level 0)))
  494.      (last val))
  495.     (while (equal exp-data ",")
  496.       (math-read-token)
  497.       (let ((rest (list (math-read-expr-level 0))))
  498.     (setcdr last rest)
  499.     (setq last rest)))
  500.     val)
  501. )
  502.  
  503. (setq calc-user-parse-table nil)
  504. (setq calc-last-main-parse-table nil)
  505. (setq calc-last-lang-parse-table nil)
  506. (setq calc-user-tokens nil)
  507. (setq calc-user-token-chars nil)
  508.  
  509. (defun math-build-parse-table ()
  510.   (let ((mtab (cdr (assq nil calc-user-parse-tables)))
  511.     (ltab (cdr (assq calc-language calc-user-parse-tables))))
  512.     (or (and (eq mtab calc-last-main-parse-table)
  513.          (eq ltab calc-last-lang-parse-table))
  514.     (let ((p (append mtab ltab))
  515.           (toks nil))
  516.       (setq calc-user-parse-table p)
  517.       (setq calc-user-token-chars nil)
  518.       (while p
  519.         (math-find-user-tokens (car (car p)))
  520.         (setq p (cdr p)))
  521.       (setq calc-user-tokens (mapconcat 'identity
  522.                         (sort (mapcar 'car toks)
  523.                           (function (lambda (x y)
  524.                                   (> (length x)
  525.                                  (length y)))))
  526.                         "\\|")
  527.         calc-last-main-parse-table mtab
  528.         calc-last-lang-parse-table ltab))))
  529. )
  530.  
  531. (defun math-find-user-tokens (p)   ; uses "toks"
  532.   (while p
  533.     (cond ((and (stringp (car p))
  534.         (or (> (length (car p)) 1) (equal (car p) "$")
  535.             (equal (car p) "\""))
  536.         (string-match "[^a-zA-Z0-9]" (car p)))
  537.        (let ((s (regexp-quote (car p))))
  538.          (if (string-match "\\`[a-zA-Z0-9]" s)
  539.          (setq s (concat "\\<" s)))
  540.          (if (string-match "[a-zA-Z0-9]\\'" s)
  541.          (setq s (concat s "\\>")))
  542.          (or (assoc s toks)
  543.          (progn
  544.            (setq toks (cons (list s) toks))
  545.            (or (memq (aref (car p) 0) calc-user-token-chars)
  546.                (setq calc-user-token-chars
  547.                  (cons (aref (car p) 0)
  548.                    calc-user-token-chars)))))))
  549.       ((consp (car p))
  550.        (math-find-user-tokens (nth 1 (car p)))
  551.        (or (eq (car (car p)) '\?)
  552.            (math-find-user-tokens (nth 2 (car p))))))
  553.     (setq p (cdr p)))
  554. )
  555.  
  556. (defun math-read-token ()
  557.   (if (>= exp-pos (length exp-str))
  558.       (setq exp-old-pos exp-pos
  559.         exp-token 'end
  560.         exp-data "\000")
  561.     (let ((ch (aref exp-str exp-pos)))
  562.       (setq exp-old-pos exp-pos)
  563.       (cond ((memq ch '(32 10 9))
  564.          (setq exp-pos (1+ exp-pos))
  565.          (if exp-keep-spaces
  566.          (setq exp-token 'space
  567.                exp-data " ")
  568.            (math-read-token)))
  569.         ((and (memq ch calc-user-token-chars)
  570.           (let ((case-fold-search nil))
  571.             (eq (string-match calc-user-tokens exp-str exp-pos)
  572.             exp-pos)))
  573.          (setq exp-token 'punc
  574.            exp-data (math-match-substring exp-str 0)
  575.            exp-pos (match-end 0)))
  576.         ((or (and (>= ch ?a) (<= ch ?z))
  577.          (and (>= ch ?A) (<= ch ?Z)))
  578.          (string-match (if (memq calc-language '(c fortran pascal maple))
  579.                    "[a-zA-Z0-9_#]*"
  580.                  "[a-zA-Z0-9'#]*")
  581.                exp-str exp-pos)
  582.          (setq exp-token 'symbol
  583.            exp-pos (match-end 0)
  584.            exp-data (math-restore-dashes
  585.                  (math-match-substring exp-str 0)))
  586.          (if (eq calc-language 'eqn)
  587.          (let ((code (assoc exp-data math-eqn-ignore-words)))
  588.            (cond ((null code))
  589.              ((null (cdr code))
  590.               (math-read-token))
  591.              ((consp (nth 1 code))
  592.               (math-read-token)
  593.               (if (assoc exp-data (cdr code))
  594.                   (setq exp-data (format "%s %s"
  595.                              (car code) exp-data))))
  596.              ((eq (nth 1 code) 'punc)
  597.               (setq exp-token 'punc
  598.                 exp-data (nth 2 code)))
  599.              (t
  600.               (math-read-token)
  601.               (math-read-token))))))
  602.         ((or (and (>= ch ?0) (<= ch ?9))
  603.          (and (eq ch '?\.)
  604.               (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos))
  605.          (and (eq ch '?_)
  606.               (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos)
  607.               (or (eq exp-pos 0)
  608.               (and (memq calc-language '(nil flat big unform
  609.                              tex eqn))
  610.                    (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
  611.                          exp-str (1- exp-pos))
  612.                    (1- exp-pos))))))
  613.          (or (and (eq calc-language 'c)
  614.               (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos))
  615.          (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" exp-str exp-pos))
  616.          (setq exp-token 'number
  617.            exp-data (math-match-substring exp-str 0)
  618.            exp-pos (match-end 0)))
  619.         ((eq ch ?\$)
  620.          (if (and (eq calc-language 'pascal)
  621.               (eq (string-match
  622.                "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
  623.                exp-str exp-pos)
  624.               exp-pos))
  625.          (setq exp-token 'number
  626.                exp-data (math-match-substring exp-str 1)
  627.                exp-pos (match-end 1))
  628.            (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos)
  629.                exp-pos)
  630.            (setq exp-data (- (string-to-int (math-match-substring
  631.                              exp-str 1))))
  632.          (string-match "\\$+" exp-str exp-pos)
  633.          (setq exp-data (- (match-end 0) (match-beginning 0))))
  634.            (setq exp-token 'dollar
  635.              exp-pos (match-end 0))))
  636.         ((eq ch ?\#)
  637.          (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos)
  638.              exp-pos)
  639.          (setq exp-data (string-to-int
  640.                  (math-match-substring exp-str 1))
  641.                exp-pos (match-end 0))
  642.            (setq exp-data 1
  643.              exp-pos (1+ exp-pos)))
  644.          (setq exp-token 'hash))
  645.         ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
  646.                    exp-str exp-pos)
  647.          exp-pos)
  648.          (setq exp-token 'punc
  649.            exp-data (math-match-substring exp-str 0)
  650.            exp-pos (match-end 0)))
  651.         ((and (eq ch ?\")
  652.           (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos))
  653.          (if (eq calc-language 'eqn)
  654.          (progn
  655.            (setq exp-str (copy-sequence exp-str))
  656.            (aset exp-str (match-beginning 1) ?\{)
  657.            (if (< (match-end 1) (length exp-str))
  658.                (aset exp-str (match-end 1) ?\}))
  659.            (math-read-token))
  660.            (setq exp-token 'string
  661.              exp-data (math-match-substring exp-str 1)
  662.              exp-pos (match-end 0))))
  663.         ((and (= ch ?\\) (eq calc-language 'tex)
  664.           (< exp-pos (1- (length exp-str))))
  665.          (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos)
  666.          (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos))
  667.          (setq exp-token 'symbol
  668.            exp-pos (match-end 0)
  669.            exp-data (math-restore-dashes
  670.                  (math-match-substring exp-str 1)))
  671.          (let ((code (assoc exp-data math-tex-ignore-words)))
  672.            (cond ((null code))
  673.              ((null (cdr code))
  674.               (math-read-token))
  675.              ((eq (nth 1 code) 'punc)
  676.               (setq exp-token 'punc
  677.                 exp-data (nth 2 code)))
  678.              ((and (eq (nth 1 code) 'mat)
  679.                (string-match " *{" exp-str exp-pos))
  680.               (setq exp-pos (match-end 0)
  681.                 exp-token 'punc
  682.                 exp-data "[")
  683.               (let ((right (string-match "}" exp-str exp-pos)))
  684.             (and right
  685.                  (setq exp-str (copy-sequence exp-str))
  686.                  (aset exp-str right ?\])))))))
  687.         ((and (= ch ?\.) (eq calc-language 'fortran)
  688.           (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
  689.                     exp-str exp-pos) exp-pos))
  690.          (setq exp-token 'punc
  691.            exp-data (upcase (math-match-substring exp-str 0))
  692.            exp-pos (match-end 0)))
  693.         ((and (eq calc-language 'math)
  694.           (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos)
  695.               exp-pos))
  696.          (setq exp-token 'punc
  697.            exp-data (math-match-substring exp-str 0)
  698.            exp-pos (match-end 0)))
  699.         ((and (eq calc-language 'eqn)
  700.           (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
  701.                     exp-str exp-pos)
  702.               exp-pos))
  703.          (setq exp-token 'punc
  704.            exp-data (math-match-substring exp-str 0)
  705.            exp-pos (match-end 0))
  706.          (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos)
  707.           (setq exp-pos (match-end 0)))
  708.          (if (memq (aref exp-data 0) '(?~ ?^))
  709.          (math-read-token)))
  710.         ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos)
  711.          (setq exp-pos (match-end 0))
  712.          (math-read-token))
  713.         (t
  714.          (if (and (eq ch ?\{) (memq calc-language '(tex eqn)))
  715.          (setq ch ?\())
  716.          (if (and (eq ch ?\}) (memq calc-language '(tex eqn)))
  717.          (setq ch ?\)))
  718.          (if (and (eq ch ?\&) (eq calc-language 'tex))
  719.          (setq ch ?\,))
  720.          (setq exp-token 'punc
  721.            exp-data (char-to-string ch)
  722.            exp-pos (1+ exp-pos))))))
  723. )
  724.  
  725.  
  726. (defun math-read-expr-level (exp-prec &optional exp-term)
  727.   (let* ((x (math-read-factor)) (first t) op op2)
  728.     (while (and (or (and calc-user-parse-table
  729.              (setq op (calc-check-user-syntax x exp-prec))
  730.              (setq x op
  731.                    op '("2x" ident 999999 -1)))
  732.             (and (setq op (assoc exp-data math-expr-opers))
  733.              (/= (nth 2 op) -1)
  734.              (or (and (setq op2 (assoc
  735.                          exp-data
  736.                          (cdr (memq op math-expr-opers))))
  737.                   (eq (= (nth 3 op) -1)
  738.                       (/= (nth 3 op2) -1))
  739.                   (eq (= (nth 3 op2) -1)
  740.                       (not (math-factor-after)))
  741.                   (setq op op2))
  742.                  t))
  743.             (and (or (eq (nth 2 op) -1)
  744.                  (memq exp-token '(symbol number dollar hash))
  745.                  (equal exp-data "(")
  746.                  (and (equal exp-data "[")
  747.                   (not (eq calc-language 'math))
  748.                   (not (and exp-keep-spaces
  749.                         (eq (car-safe x) 'vec)))))
  750.              (or (not (setq op (assoc exp-data math-expr-opers)))
  751.                  (/= (nth 2 op) -1))
  752.              (or (not calc-user-parse-table)
  753.                  (not (eq exp-token 'symbol))
  754.                  (let ((p calc-user-parse-table))
  755.                    (while (and p
  756.                        (or (not (integerp
  757.                              (car (car (car p)))))
  758.                            (not (equal
  759.                              (nth 1 (car (car p)))
  760.                              exp-data))))
  761.                  (setq p (cdr p)))
  762.                    (not p)))
  763.              (setq op (assoc "2x" math-expr-opers))))
  764.         (not (and exp-term (equal exp-data exp-term)))
  765.         (>= (nth 2 op) exp-prec))
  766.       (if (not (equal (car op) "2x"))
  767.       (math-read-token))
  768.       (and (memq (nth 1 op) '(sdev mod))
  769.        (calc-extensions))
  770.       (setq x (cond ((consp (nth 1 op))
  771.              (funcall (car (nth 1 op)) x op))
  772.             ((eq (nth 3 op) -1)
  773.              (if (eq (nth 1 op) 'ident)
  774.              x
  775.                (if (eq (nth 1 op) 'closing)
  776.                (if (eq (nth 2 op) exp-prec)
  777.                    (progn
  778.                  (setq exp-prec 1000)
  779.                  x)
  780.                  (throw 'syntax "Mismatched delimiters"))
  781.              (list (nth 1 op) x))))
  782.             ((and (not first)
  783.               (memq (nth 1 op) math-alg-inequalities)
  784.               (memq (car-safe x) math-alg-inequalities))
  785.              (calc-extensions)
  786.              (math-composite-inequalities x op))
  787.             (t (list (nth 1 op)
  788.                  x
  789.                  (math-read-expr-level (nth 3 op) exp-term))))
  790.         first nil))
  791.     x)
  792. )
  793.  
  794. (defun calc-check-user-syntax (&optional x prec)
  795.   (let ((p calc-user-parse-table)
  796.     (matches nil)
  797.     match rule)
  798.     (while (and p
  799.         (or (not (progn
  800.                (setq rule (car (car p)))
  801.                (if x
  802.                    (and (integerp (car rule))
  803.                     (>= (car rule) prec)
  804.                     (equal exp-data
  805.                        (car (setq rule (cdr rule)))))
  806.                  (equal exp-data (car rule)))))
  807.             (let ((save-exp-pos exp-pos)
  808.               (save-exp-old-pos exp-old-pos)
  809.               (save-exp-token exp-token)
  810.               (save-exp-data exp-data))
  811.               (or (not (listp
  812.                 (setq matches (calc-match-user-syntax rule))))
  813.               (let ((args (progn
  814.                     (calc-extensions)
  815.                     calc-arg-values))
  816.                 (conds nil)
  817.                 temp)
  818.                 (if x
  819.                 (setq matches (cons x matches)))
  820.                 (setq match (cdr (car p)))
  821.                 (while (and (eq (car-safe match)
  822.                         'calcFunc-condition)
  823.                     (= (length match) 3))
  824.                   (setq conds (append (math-flatten-lands
  825.                            (nth 2 match))
  826.                           conds)
  827.                     match (nth 1 match)))
  828.                 (while (and conds match)
  829.                   (calc-extensions)
  830.                   (cond ((eq (car-safe (car conds))
  831.                      'calcFunc-let)
  832.                      (setq temp (car conds))
  833.                      (or (= (length temp) 3)
  834.                      (and (= (length temp) 2)
  835.                           (eq (car-safe (nth 1 temp))
  836.                           'calcFunc-assign)
  837.                           (= (length (nth 1 temp)) 3)
  838.                           (setq temp (nth 1 temp)))
  839.                      (setq match nil))
  840.                      (setq matches (cons
  841.                             (math-normalize
  842.                              (math-multi-subst
  843.                               (nth 2 temp)
  844.                               args matches))
  845.                             matches)
  846.                        args (cons (nth 1 temp)
  847.                               args)))
  848.                     ((and (eq (car-safe (car conds))
  849.                           'calcFunc-matches)
  850.                       (= (length (car conds)) 3))
  851.                      (setq temp (calcFunc-vmatches
  852.                          (math-multi-subst
  853.                           (nth 1 (car conds))
  854.                           args matches)
  855.                          (nth 2 (car conds))))
  856.                      (if (eq temp 0)
  857.                      (setq match nil)
  858.                        (while (setq temp (cdr temp))
  859.                      (setq matches (cons (nth 2 (car temp))
  860.                                  matches)
  861.                            args (cons (nth 1 (car temp))
  862.                               args)))))
  863.                     (t
  864.                      (or (math-is-true (math-simplify
  865.                             (math-multi-subst
  866.                              (car conds)
  867.                              args matches)))
  868.                      (setq match nil))))
  869.                   (setq conds (cdr conds)))
  870.                 (if match
  871.                 (not (setq match (math-multi-subst
  872.                           match args matches)))
  873.                   (setq exp-old-pos save-exp-old-pos
  874.                     exp-token save-exp-token
  875.                     exp-data save-exp-data
  876.                     exp-pos save-exp-pos)))))))
  877.       (setq p (cdr p)))
  878.     (and p match))
  879. )
  880.  
  881. (defun calc-match-user-syntax (p &optional term)
  882.   (let ((matches nil)
  883.     (save-exp-pos exp-pos)
  884.     (save-exp-old-pos exp-old-pos)
  885.     (save-exp-token exp-token)
  886.     (save-exp-data exp-data))
  887.     (while (and p
  888.         (cond ((stringp (car p))
  889.                (and (equal exp-data (car p))
  890.                 (progn
  891.                   (math-read-token)
  892.                   t)))
  893.               ((integerp (car p))
  894.                (and (setq m (catch 'syntax
  895.                       (math-read-expr-level
  896.                        (car p)
  897.                        (if (cdr p)
  898.                        (if (consp (nth 1 p))
  899.                            (car (nth 1 (nth 1 p)))
  900.                          (nth 1 p))
  901.                      term))))
  902.                 (not (stringp m))
  903.                 (setq matches (nconc matches (list m)))))
  904.               ((eq (car (car p)) '\?)
  905.                (setq m (calc-match-user-syntax (nth 1 (car p))))
  906.                (or (nth 2 (car p))
  907.                (setq matches
  908.                  (nconc matches
  909.                     (list
  910.                      (cons 'vec (and (listp m) m))))))
  911.                (or (listp m) (not (nth 2 (car p)))
  912.                (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
  913.                (eq exp-token 'end)))
  914.               (t
  915.                (setq m (calc-match-user-syntax (nth 1 (car p))
  916.                                (car (nth 2 (car p)))))
  917.                (if (listp m)
  918.                (let ((vec (cons 'vec m))
  919.                  opos mm)
  920.                  (while (and (listp
  921.                       (setq opos exp-pos
  922.                         mm (calc-match-user-syntax
  923.                             (or (nth 2 (car p))
  924.                             (nth 1 (car p)))
  925.                             (car (nth 2 (car p))))))
  926.                      (> exp-pos opos))
  927.                    (setq vec (nconc vec mm)))
  928.                  (setq matches (nconc matches (list vec))))
  929.              (and (eq (car (car p)) '*)
  930.                   (setq matches (nconc matches (list '(vec)))))))))
  931.       (setq p (cdr p)))
  932.     (if p
  933.     (setq exp-pos save-exp-pos
  934.           exp-old-pos save-exp-old-pos
  935.           exp-token save-exp-token
  936.           exp-data save-exp-data
  937.           matches "Failed"))
  938.     matches)
  939. )
  940.  
  941. (defconst math-alg-inequalities
  942.   '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
  943.         calcFunc-eq calcFunc-neq))
  944.  
  945. (defun math-remove-dashes (x)
  946.   (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
  947.       (math-remove-dashes
  948.        (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
  949.     x)
  950. )
  951.  
  952. (defun math-restore-dashes (x)
  953.   (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
  954.       (math-restore-dashes
  955.        (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
  956.     x)
  957. )
  958.  
  959. (defun math-read-if (cond op)
  960.   (let ((then (math-read-expr-level 0)))
  961.     (or (equal exp-data ":")
  962.     (throw 'syntax "Expected ':'"))
  963.     (math-read-token)
  964.     (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))
  965. )
  966.  
  967. (defun math-factor-after ()
  968.   (let ((exp-pos exp-pos)
  969.     exp-old-pos exp-token exp-data)
  970.     (math-read-token)
  971.     (or (memq exp-token '(number symbol dollar hash string))
  972.     (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
  973.          (assoc (concat "u" exp-data) math-expr-opers))
  974.     (eq (nth 2 (assoc exp-data math-expr-opers)) -1)
  975.     (assoc exp-data '(("(") ("[") ("{")))))
  976. )
  977.  
  978. (defun math-read-factor ()
  979.   (let (op)
  980.     (cond ((eq exp-token 'number)
  981.        (let ((num (math-read-number exp-data)))
  982.          (if (not num)
  983.          (progn
  984.            (setq exp-old-pos exp-pos)
  985.            (throw 'syntax "Bad format")))
  986.          (math-read-token)
  987.          (if (and math-read-expr-quotes
  988.               (consp num))
  989.          (list 'quote num)
  990.            num)))
  991.       ((and calc-user-parse-table
  992.         (setq op (calc-check-user-syntax)))
  993.        op)
  994.       ((or (equal exp-data "-")
  995.            (equal exp-data "+")
  996.            (equal exp-data "!")
  997.            (equal exp-data "|")
  998.            (equal exp-data "/"))
  999.        (setq exp-data (concat "u" exp-data))
  1000.        (math-read-factor))
  1001.       ((and (setq op (assoc exp-data math-expr-opers))
  1002.         (eq (nth 2 op) -1))
  1003.        (if (consp (nth 1 op))
  1004.            (funcall (car (nth 1 op)) op)
  1005.          (math-read-token)
  1006.          (let ((val (math-read-expr-level (nth 3 op))))
  1007.            (cond ((eq (nth 1 op) 'ident)
  1008.               val)
  1009.              ((and (Math-numberp val)
  1010.                (equal (car op) "u-"))
  1011.               (math-neg val))
  1012.              (t (list (nth 1 op) val))))))
  1013.       ((eq exp-token 'symbol)
  1014.        (let ((sym (intern exp-data)))
  1015.          (math-read-token)
  1016.          (if (equal exp-data calc-function-open)
  1017.          (let ((f (assq sym math-expr-function-mapping)))
  1018.            (math-read-token)
  1019.            (if (consp (cdr f))
  1020.                (funcall (car (cdr f)) f sym)
  1021.              (let ((args (if (or (equal exp-data calc-function-close)
  1022.                      (eq exp-token 'end))
  1023.                      nil
  1024.                    (math-read-expr-list))))
  1025.                (if (not (or (equal exp-data calc-function-close)
  1026.                     (eq exp-token 'end)))
  1027.                (throw 'syntax "Expected `)'"))
  1028.                (math-read-token)
  1029.                (if (and (eq calc-language 'fortran) args
  1030.                 (calc-extensions)
  1031.                 (let ((calc-matrix-mode 'scalar))
  1032.                   (math-known-matrixp
  1033.                    (list 'var sym
  1034.                      (intern
  1035.                       (concat "var-"
  1036.                           (symbol-name sym)))))))
  1037.                (math-parse-fortran-subscr sym args)
  1038.              (if f
  1039.                  (setq sym (cdr f))
  1040.                (and (= (aref (symbol-name sym) 0) ?\\)
  1041.                 (< (prefix-numeric-value calc-language-option)
  1042.                    0)
  1043.                 (setq sym (intern (substring (symbol-name sym)
  1044.                                  1))))
  1045.                (or (string-match "-" (symbol-name sym))
  1046.                    (setq sym (intern
  1047.                       (concat "calcFunc-"
  1048.                           (symbol-name sym))))))
  1049.              (cons sym args)))))
  1050.            (if math-read-expr-quotes
  1051.            sym
  1052.          (let ((val (list 'var
  1053.                   (intern (math-remove-dashes
  1054.                        (symbol-name sym)))
  1055.                   (if (string-match "-" (symbol-name sym))
  1056.                       sym
  1057.                     (intern (concat "var-"
  1058.                             (symbol-name sym)))))))
  1059.            (let ((v (assq (nth 1 val) math-expr-variable-mapping)))
  1060.              (and v (setq val (if (consp (cdr v))
  1061.                       (funcall (car (cdr v)) v val)
  1062.                     (list 'var
  1063.                           (intern
  1064.                            (substring (symbol-name (cdr v))
  1065.                               4))
  1066.                           (cdr v))))))
  1067.            (while (and (memq calc-language '(c pascal maple))
  1068.                    (equal exp-data "["))
  1069.              (math-read-token)
  1070.              (setq val (append (list 'calcFunc-subscr val)
  1071.                        (math-read-expr-list)))
  1072.              (if (equal exp-data "]")
  1073.              (math-read-token)
  1074.                (throw 'syntax "Expected ']'")))
  1075.            val)))))
  1076.       ((eq exp-token 'dollar)
  1077.        (let ((abs (if (> exp-data 0) exp-data (- exp-data))))
  1078.          (if (>= (length calc-dollar-values) abs)
  1079.          (let ((num exp-data))
  1080.            (math-read-token)
  1081.            (setq calc-dollar-used (max calc-dollar-used num))
  1082.            (math-check-complete (nth (1- abs) calc-dollar-values)))
  1083.            (throw 'syntax (if calc-dollar-values
  1084.                   "Too many $'s"
  1085.                 "$'s not allowed in this context")))))
  1086.       ((eq exp-token 'hash)
  1087.        (or calc-hashes-used
  1088.            (throw 'syntax "#'s not allowed in this context"))
  1089.        (calc-extensions)
  1090.        (if (<= exp-data (length calc-arg-values))
  1091.            (let ((num exp-data))
  1092.          (math-read-token)
  1093.          (setq calc-hashes-used (max calc-hashes-used num))
  1094.          (nth (1- num) calc-arg-values))
  1095.          (throw 'syntax "Too many # arguments")))
  1096.       ((equal exp-data "(")
  1097.        (let* ((exp (let ((exp-keep-spaces nil))
  1098.              (math-read-token)
  1099.              (if (or (equal exp-data "\\dots")
  1100.                  (equal exp-data "\\ldots"))
  1101.                  '(neg (var inf var-inf))
  1102.                (math-read-expr-level 0)))))
  1103.          (let ((exp-keep-spaces nil))
  1104.            (cond
  1105.         ((equal exp-data ",")
  1106.          (progn
  1107.            (math-read-token)
  1108.            (let ((exp2 (math-read-expr-level 0)))
  1109.              (setq exp
  1110.                (if (and exp2 (Math-realp exp) (Math-realp exp2))
  1111.                    (math-normalize (list 'cplx exp exp2))
  1112.                  (list '+ exp (list '* exp2 '(var i var-i))))))))
  1113.         ((equal exp-data ";")
  1114.          (progn
  1115.            (math-read-token)
  1116.            (let ((exp2 (math-read-expr-level 0)))
  1117.              (setq exp (if (and exp2 (Math-realp exp)
  1118.                     (Math-anglep exp2))
  1119.                    (math-normalize (list 'polar exp exp2))
  1120.                  (calc-extensions)
  1121.                  (list '* exp
  1122.                        (list 'calcFunc-exp
  1123.                          (list '*
  1124.                            (math-to-radians-2 exp2)
  1125.                            '(var i var-i)))))))))
  1126.         ((or (equal exp-data "\\dots")
  1127.              (equal exp-data "\\ldots"))
  1128.          (progn
  1129.            (math-read-token)
  1130.            (let ((exp2 (if (or (equal exp-data ")")
  1131.                        (equal exp-data "]")
  1132.                        (eq exp-token 'end))
  1133.                    '(var inf var-inf)
  1134.                  (math-read-expr-level 0))))
  1135.              (setq exp
  1136.                (list 'intv
  1137.                  (if (equal exp-data ")") 0 1)
  1138.                  exp
  1139.                  exp2)))))))
  1140.          (if (not (or (equal exp-data ")")
  1141.               (and (equal exp-data "]") (eq (car-safe exp) 'intv))
  1142.               (eq exp-token 'end)))
  1143.          (throw 'syntax "Expected `)'"))
  1144.          (math-read-token)
  1145.          exp))
  1146.       ((eq exp-token 'string)
  1147.        (calc-extensions)
  1148.        (math-read-string))
  1149.       ((equal exp-data "[")
  1150.        (calc-extensions)
  1151.        (math-read-brackets t "]"))
  1152.       ((equal exp-data "{")
  1153.        (calc-extensions)
  1154.        (math-read-brackets nil "}"))
  1155.       ((equal exp-data "<")
  1156.        (calc-extensions)
  1157.        (math-read-angle-brackets))
  1158.       (t (throw 'syntax "Expected a number"))))
  1159. )
  1160.  
  1161.  
  1162.  
  1163.